library(leaflet)
library(leaflet.minicharts)
library(widgetframe)
library(sf)
library(readr)
library(dplyr)
library(RColorBrewer)
library(xfun)
library(writexl)
### prepearing the data
# convert lines to UTF-8 (replacing problematic chars)
raw_lines <- readLines("onlyMicrotus_B_MicrotusSamplesV426.txt", encoding = "latin1")
clean_lines <- iconv(raw_lines, from = "latin1", to = "UTF-8", sub = "")
# Save cleaned file
writeLines(clean_lines, "onlyMicrotus_B_MicrotusSamplesV426_cleaned.txt")
rawTable <- read_tsv("onlyMicrotus_B_MicrotusSamplesV426_cleaned.txt")
#col_types = cols(
#Add = col_character(),
#Published = col_character(),
#.default = col_guess()) # let other columns be guessed
#nrow(rawTable)
#colnames(rawTable)
cols <- c("Genus", "Species", "Samplinglocation", "Country", "Sample number (on tube or bag)", "Individual number", "Extraction y/n?", "Place of capture", "Latitude", "Longitude", "Specimen-20", "DNADNA_.Number.in..20", "RNARNA_.Number.in..80")
# Other cols: "Microsat", "Cytochrom b", "GewebeRack", "Number in Fridge oder -20C oder -80C", "Lung.Tissue", "Positive? (TULV)", "Published")
Data <- rawTable[, cols]
#View(Data)
# filter data for species "arvalis"
arvalis_data <- Data %>% filter(Species == "arvalis")
# replace non-breaking spaces (\u00A0) and any spaces around numbers in Longitude and Latitude
arvalis_data$Longitude <- gsub("\u00A0", "", arvalis_data$Longitude)
arvalis_data$Latitude <- gsub("\u00A0", "", arvalis_data$Latitude)
# Convert coordinates to numeric if needed
arvalis_data$Longitude <- as.numeric(as.character(arvalis_data$Longitude))
arvalis_data$Latitude <- as.numeric(as.character(arvalis_data$Latitude))
#View(arvalis_data)
# samples to add (color in red samples from locations that I plan to sequence):
add_samples <- c("MarFSi01","MarFSJ456", "MarFTr01","MarFCm04",
"MarFCm01","MarFM05",
"MarGBGGo01","MarGBGCh01","MarGBGAt04","MarGBGAe01",
"MarFFo01", "MarFBe01", "MarFVi01",
"MarOMDo01", "MarOMGr01", "MarOMSw01", "MarOMWr01", "MarOMPs01")
# already published samples
WangHeckel2025 <- c("BSt095", "BVe061", "FBv02", "FCc02", "FDa504", "FFr549", "FGr14",
"FGr14", "FMc03", "FOg02", "FPi555", "FSt24", "OBSO234", "OBWs01",
"OEOs14", "OEOs15", "OMBr149", "OMHo277", "ORGs21", "ORWa268",
"OSaLi257", "OSaNe01", "OSJC01", "OSWi166", "OWLs033", "OWPg01")
Wang2023 <- c("BSt095", "BVe061", "FDa504", "FFr549", "FMc03", "FPi555", "Ft24",
"FA01", "FCh05", "FTh497", "EMq03", "ESa08", "ESAv05", "FM05", "OBSO234",
"OBWs01", "OBWs02", "OEOs14", "OEOs15", "OMBr149", "OMHo277", "OMSe194",
"OMSO221", "OMSQ273", "ORGs21", "ORNe205", "ORWa268", "OSaLi257", "OSaNe01",
"OSaWh256", "OSGr134", "OSJC01", "OSWi166", "OWLs033", "OWNe051", "OWPg01",
"CHBo17", "CHVa02", "ISc01", "CZD02", "PSr06", "RuKo01", "DAb06", "DWa04", "He42")
# all published samples
published <- unique(c(WangHeckel2025, Wang2023))
published <- paste0("Mar", published)
published
arvalis_data <- arvalis_data %>%
mutate(
Published = `Individual number` %in% published,
Add_marked = `Individual number` %in% add_samples)
#View(arvalis_data)
# summarise by coordinate and assign color priority
coords_summary <- arvalis_data %>%
filter(!is.na(Latitude), !is.na(Longitude)) %>%
group_by(Longitude, Latitude) %>%
summarise(
sample_count = n(),
countries = paste(unique(Country), collapse = ", "),
samples_info = list(
tibble(
sample_name = `Individual number`,
dna = DNADNA_.Number.in..20,
rna = RNARNA_.Number.in..80,
Frozen_body = `Specimen-20`)),
Location = Samplinglocation,
has_add_sample = any(Add_marked),
has_published = any(Published),
color = case_when(
has_add_sample ~ "red",
has_published ~ "green",
TRUE ~ "darkgrey"),
.groups = "drop")
#View(coords_summary)
# color each sample based on presence/absence of frozen specimen or DNA/RNA
color_sample_name <- function(sample_name, Frozen_body) {
# has_dna <- !is.na(dna) & dna != ""
# has_rna <- !is.na(rna) & rna != ""
has_body <- !is.na(Frozen_body) && Frozen_body != ""
### change here so that frozen body is visible
color <- if (has_body) {"blue"}
# if (has_dna & has_rna) {"orange"}
# else if (has_dna) {"blue"}
# else if (has_rna) {"violet"}
else {"black"}
paste0('<span style="color:', color, ';">', sample_name, '</span>')}
coords_summary <- coords_summary %>%
rowwise() %>%
mutate(
samples_colored = paste(
sapply(1:nrow(samples_info), function(i) {
color_sample_name(
samples_info$sample_name[i],
samples_info$Frozen_body[i])}),
# samples_info$dna[i],
# samples_info$rna[i]
collapse = "<br>")) %>%
ungroup()
# split into three color groups
red_dots <- coords_summary %>% filter(color == "red")
green_dots <- coords_summary %>% filter(color == "green")
grey_dots <- coords_summary %>% filter(color == "darkgrey")
### creating the map
# base map
map <- leaflet() %>%
setView(lat = 49.76666667, lng = 0.516666667, zoom = 7) %>%
addTiles()
# add grey dots first (bottom layer)
map <- map %>%
addCircleMarkers(
data = grey_dots,
lng = ~Longitude, lat = ~Latitude,
label = ~Location,
color = "darkgrey",
radius = ~5, # + sample_count / 20,
weight = 1, opacity = 1, fillOpacity = 0.5,
popup = ~paste0(
"<b>Coordinates:</b> ", Latitude, ", ", Longitude, "<br>",
"<b>Samples at this location:</b> ", sample_count, "<br>",
"<b>Country:</b> ", countries, "<br>",
"<b>Location:</b> ", Location, "<br>",
"<b>Sample IDs:</b><br>", samples_colored))
#label = ~paste0("Lat: ", Latitude, ", Lon: ", Longitude)
# add green dots (middle layer)
map <- map %>%
addCircleMarkers(
data = green_dots,
lng = ~Longitude, lat = ~Latitude,
label = ~Location,
color = "green",
radius = ~5, # + sample_count / 20,
weight = 1, opacity = 1, fillOpacity = 0.8,
popup = ~paste0(
"<b>Coordinates:</b> ", Latitude, ", ", Longitude, "<br>",
"<b>Samples at this location:</b> ", sample_count, "<br>",
"<b>Countries:</b> ", countries, "<br>",
"<b>Location:</b> ", Location, "<br>",
"<b>Sample IDs:</b><br>", samples_colored))
# add red dots last (top layer)
map <- map %>%
addCircleMarkers(
data = red_dots,
lng = ~Longitude, lat = ~Latitude,
label = ~Location,
color = "red",
radius = ~5, # + sample_count / 20
weight = 1, opacity = 1, fillOpacity = 0.9,
popup = ~paste0(
"<b>Coordinates:</b> ", Latitude, ", ", Longitude, "<br>",
"<b>Samples at this location:</b> ", sample_count, "<br>",
"<b>Countries:</b> ", countries, "<br>",
"<b>Location:</b> ", Location, "<br>",
"<b>Sample IDs:</b><br>", samples_colored))
# add legends
map <- map %>%
addLegend(
position = "bottomleft",
colors = c("darkgrey", "green", "red"),
labels = c("Sampled locations", "Published (2023/2025)", "Samples to add"),
title = "Dot color legend",
opacity = 1) %>%
addLegend(
position = "topright",
colors = "blue", # colors = c("blue", "violet", "orange"),
labels = "Frozen specimen at -20", # labels = c("DNA extracted", "RNA extracted", "DNA & RNA extracted"),
title = "Sample ID color legend",
opacity = 1)